procedure CopyFolder(src, Dest : string);
var
     Files : integer;
     FSrc, FDest : string;
     ok     : boolean;
     Search : TSearchRec;
 begin
      Files := FindFirst(src + '\*.*', faAnyFile, Search);

      while Files = 0 do
       begin
            if Search.Attr <> faDirectory then
             begin
                  FSrc := src + '\' + Search.Name;
                  FDest := dest + '\' + Search.Name;
                  ok :=CopyFile(PChar(FSrc),
                                     PChar(FDest),false);
                  if not ok then ShowMessage(' Copy error: '+
                                                                             Search.Name);
             end
            else
             begin
                  if (Search.Name <> '.') and
                                                    (Search.Name <> '..') then
                   begin
                        {$I-}
                        MkDir(Dest + '\' + Search.Name);
                        {$I+}
                        if IOResult<>0 then
                        ShowMessage('Can not create ' + Search.Name)
                        else
                           CopyFolder(src+'\'+Search.Name,Dest
                                                                      +'\'+Search.Name);
                   end;
             end;
            Files := FindNext(Search);
       end;

      FindClose(Search);
 end;
